home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib05.dsk
/
APPLE MAPS.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
27KB
|
713 lines
1 REM *************************************
2 REM * THE APPLE M.A.P.S. SYSTEM *
3 REM * (MARKETING AND PERSONAL SHOPPING) *
4 REM * BY GLENN TEMAN *
5 REM * APPLESOFT BASIC *
6 REM * COPYRIGHT (C) 1981 *
7 REM * BY MICRO-SPARC INC *
8 REM *************************************
9 :
10 GOTO 60000: REM TITLE PG & INIT
20 REM ** SEARCH **
30 REM
40 REM SET K=0 -> COUNT OF HITS
50 K = 0:L = LEN(A$):B$ = ""
60 FOR I = 1 TO LL
70 REM PARTIAL LOOKUP - INDEX A HIT IN C%
80 IF A$ = LEFT$(N$(I),L) THEN K = K +1:C%(K) = I
90 REM IF >10 HITS, DISPLAY THEM
100 REM ON ^, LEAVE SEARCH
110 IF K >10 THEN GOSUB 250: IF B$ = "^" THEN HIT = 0: RETURN
120 REM IF @, A CHOICE WAS MADE
130 IF B$ = "@" THEN 190
140 REM NO @ OR ^: CONTINUE SEARCH
150 NEXT
160 REM -NO HITS
170 IF K = 0 THEN HIT = 0: PRINT " <NOT FOUND>";P$: RETURN
180 REM -ONE HIT
190 IF K = 1 THEN PRINT : PRINT " * ";N$(C%(1)):HIT = C%(1): GOSUB 400: RETURN
200 REM -MORE THAN ONE HIT
210 REM ON ^, LEAVE
220 GOSUB 250: IF B$ = "^" THEN HIT = 0: RETURN
230 REM A CHOICE WAS MADE
240 GOTO 190
250 REM ** SEARCH DISPLAY **
260 REM A% IS FLAG FOR >10 HITS
270 A% = 0: IF K = 11 THEN K = 10:A% = 1
280 PRINT
290 FOR J = 1 TO K
300 REM DISPLAY LIST OF HITS
310 PRINT J;") ";N$(C%(J))
320 NEXT
330 PRINT : PRINT "<1-";K;" OR ^";: IF A% = 1 THEN PRINT " OR C(ONTINUE)";
340 INPUT " > ";B$: IF B$ = "^" THEN RETURN
350 REM CONTINUE IF >10 HITS AND 'C'
360 IF A% = 1 AND B$ = "C" THEN K = 1:C%(1) = C%(11): RETURN
370 B% = VAL(B$): IF B% <1 OR B% >K THEN PRINT CHR$(7);: GOTO 330
380 REM MADE A CHOICE. SET @ FLAG
390 K = 1:C%(1) = C%(B%):B$ = "@": RETURN
400 REM ** SEARCH: HIT OK? **
410 PRINT " OK (RTN/N)? ";
420 INPUT "";A$: IF LEFT$(A$,1) = "Y" OR A$ = "" THEN RETURN
430 REM OK='NOPE'
440 HIT = 0: IF A% = 1 THEN K = 1:C%(1) = C%(11): REM CONTINUE SCH IF >10 HITS
450 RETURN
490 FOR I = 1 TO 750: NEXT I: RETURN
499 REM
500 REM ** PRINT GROC LIST **
510 REM
515 REM SET PR FLAG=1 FOR PRINT
520 PR = 1:A$ = "PRINT": GOTO 560
529 REM
530 REM ** VIEW GROC LIST **
540 REM
550 PR = 0:A$ = "VIEW"
560 A$ = A$ +" GROCERY LIST"
580 GOSUB 52000: REM TOP TITLE
590 VTAB 5: PRINT "BY AISLE OR": CALL -868
600 HTAB 4: INPUT "TYPE OF GROCERY (A / T)? ";A$
610 IF A$ = "" OR LEFT$(A$,1) = "A" THEN L = 0: VTAB 6: HTAB 29: PRINT "AISLE": GOTO 640
620 IF LEFT$(A$,1) = "T" THEN L = 1: VTAB 6: HTAB 29: PRINT "TYPE": GOTO 640
630 PRINT P$;: GOTO 590
640 VTAB 12: PRINT " <PRESS '^' KEY TO ABORT>"
650 IF NOT PR THEN GOSUB 490: HOME
670 IF PR THEN PRINT D$;"PR#";SLOT
680 PRINT "GROCERY LIST": PRINT "============": PRINT
690 IF L THEN 900: REM GOTO BY TYPE
700 REM -BY AISLE-
710 PRINT D$;"OPEN";FL$;",L40"
715 REM LOOP ON AISLES
720 FOR I = 1 TO SA
725 REM SET NEW AISLE FLAG
730 K = 1
740 FOR J = 1 TO AI%(I,0)
750 L = AI%(I,J): IF L = 0 THEN 840
760 IF PEEK( -16384) >127 THEN A% = PEEK( -16384): POKE -16368,0: IF A% = 222 THEN PRINT : PRINT "<ABORTED>": GOTO 1070
770 PRINT D$;"READ";FL$;",R";L
780 INPUT QOH,FS
790 IF QOH > = FS THEN 840
800 IF K THEN PRINT : PRINT "AISLE ";I:K = 0
810 PRINT CHR$(95); CHR$(95); CHR$(95);" ";
820 PRINT FS -QOH; TAB( 8);N$(L);
830 PRINT " (";QOH;")"; TAB( 36); CHR$(91);"...]"
840 NEXT J
850 NEXT I
860 PRINT D$;"CLOSE";FL$
870 GOTO 1070
899 REM -BY TYPE-
900 PRINT D$;"OPEN";FL$;",L40"
905 REM LOOP ON TYPES
910 FOR I = 1 TO ST
920 K = 1
930 FOR J = 1 TO TI%(I,0)
940 L = TI%(I,J)
950 IF PEEK( -16384) >127 THEN A% = PEEK( -16384): POKE -16368,0: IF A% = 222 THEN PRINT : PRINT "<ABORTED>": GOTO 1070
960 PRINT D$;"READ";FL$;",R";L
970 INPUT QOH,FS
980 IF QOH > = FS THEN 1030
990 IF K THEN PRINT : PRINT TP$(I):K = 0
1000 PRINT CHR$(95); CHR$(95); CHR$(95);" ";
1010 PRINT FS -QOH; TAB( 8);N$(L);
1020 PRINT " (";QOH;")"; TAB( 36); CHR$(91);"...]"
1030 NEXT J
1040 NEXT I
1050 PRINT D$;"CLOSE";FL$
1070 PRINT : PRINT D$;"PR#0"
1080 PRINT "<DONE. HIT ANY KEY TO CONTINUE...";
1090 GET A$: PRINT
1100 RETURN
1199 REM
1200 REM ** UPDATE INVENTORY **
1210 REM
1220 A$ = "UPDATE INVENTORY": GOSUB 52000
1230 VTAB 7: HTAB 1: INPUT "WHICH GROCERY? ";A$
1240 IF A$ = "^" OR A$ = "" THEN RETURN
1250 GOSUB 20: REM SEARCH
1260 IF NOT HIT THEN GOSUB 490: VTAB 5: CALL -958: GOTO 1230
1265 VTAB 8: CALL -958: PRINT
1270 PRINT N$(HIT)
1280 PRINT D$;"OPEN";FL$;",L40"
1290 PRINT D$;"READ";FL$;",R";HIT
1300 INPUT QOH,FS,IL,TY,C$,HM
1310 PRINT D$;"CLOSE";FL$
1320 PRINT " FULL STOCK=";FS; TAB( 18);"QOH=";QOH
1330 VTAB 12: CALL -868: HTAB 5: INPUT "> UPDATE BY (+ OR -N): ";A$
1340 IF A$ = "^" OR A$ = "" THEN PRINT " <IGNORED>": GOSUB 490: VTAB 5: CALL -958: GOTO 1230
1350 A% = VAL(A$)
1360 B% = A% +QOH: IF B% <0 OR B% >99 THEN PRINT P$;: GOTO 1330
1363 VTAB 15: PRINT "=> NEW QOH = ";B%: INPUT " OK (Y)? ";A$
1365 IF LEFT$(A$,1) < >"Y" AND A$ < >"" THEN VTAB 11: CALL -958: GOTO 1330
1370 PRINT D$;"OPEN";FL$;",L40"
1380 PRINT D$;"WRITE";FL$;",R";HIT
1390 PRINT B%: PRINT FS: PRINT IL: PRINT TY
1400 PRINT C$: IF A% >0 THEN HM = HM +A%
1405 IF HM >9999 THEN HM = 9999
1410 PRINT HM
1420 PRINT D$;"CLOSE";FL$
1440 GOSUB 490: VTAB 5: CALL -958: GOTO 1230
1499 REM
1500 REM ** INPUT **
1510 REM
1515 REM SET ED FLAG TO 0 FOR INPUT
1520 ED = 0:A$ = "INPUT GROCERY": GOSUB 52000
1530 IF LL +1 >SZ THEN PRINT : PRINT "<THERE ARE ALREADY ";LL;" ITEMS ON FILE.>": PRINT "<THE FILES ARE FULL - INPUT DISALLOWED.>": RETURN
1540 GOTO 1580
1549 REM
1550 REM ** EDIT **
1560 REM
1565 REM SET ED TO 1 FOR EDIT
1570 ED = 1:A$ = "EDIT GROCERY": GOSUB 52000
1580 VTAB 3: CALL -958
1590 IF NOT ED THEN 1640
1600 VTAB 4: HTAB 1: CALL -868: INPUT "WHICH GROCERY? (^ TO END) ";A$: IF A$ = "" OR A$ = "^" THEN RETURN
1610 GOSUB 20: REM SEARCH
1620 IF NOT HIT THEN GOSUB 490: GOTO 1570
1630 VTAB 5: HTAB 1: CALL -958
1640 VTAB 6: HTAB 1: CALL -868: PRINT "GROCERY:"
1650 VTAB 9: HTAB 1: CALL -868: PRINT "QUANT ON HAND:"
1660 VTAB 12: HTAB 1: CALL -868: PRINT "FULL STOCK:"
1670 VTAB 15: HTAB 1: CALL -868: PRINT "AISLE:"
1680 VTAB 18: HTAB 1: CALL -868: PRINT "TYPE:"
1690 IF NOT ED THEN 1790
1700 PRINT D$;"OPEN";FL$;",L40"
1710 PRINT D$;"READ";FL$;",R";HIT
1715 REM READ OLD VALUES
1720 INPUT QOH,FS,IL,TY,C$,HM
1730 PRINT D$;"CLOSE";FL$
1740 VTAB 7: HTAB 10: PRINT "(";C$;")"
1750 VTAB 10: HTAB 16: PRINT "(";QOH;")"
1760 VTAB 13: HTAB 13: PRINT "(";FS;")"
1770 VTAB 16: HTAB 8: PRINT "(";IL;")"
1780 VTAB 19: HTAB 7: PRINT "(";TP$(TY);")"
1790 VTAB 6: HTAB 11: CALL -868: INPUT "";A$
1795 REM IF ED=1 AND ENTER "" THEN GET DEFAULT
1800 IF ED AND A$ = "" THEN A$ = C$: VTAB 6: HTAB 11: PRINT A$
1810 IF A$ = "" OR A$ = "^" THEN RETURN
1820 IF LEN(A$) >20 THEN PRINT P$;: GOTO 1790
1830 IF ED THEN 1880
1840 FOR I = 1 TO LL: IF A$ = N$(I) THEN 1870
1850 NEXT
1860 GOTO 1880
1870 HTAB 5: PRINT "<ALREADY ON FILE!>";P$;: GOSUB 490: HTAB 1: CALL -868: GOTO 1790
1880 C$ = A$
1890 VTAB 9: HTAB 17: CALL -868: INPUT "";A$
1900 IF A$ = "^" THEN CALL -868: PRINT " <IGNORED>": GOSUB 490: GOTO 1580
1910 IF A$ = "" AND ED THEN A$ = STR$(QOH): VTAB 9: HTAB 17: PRINT A$
1920 A% = VAL(A$): IF A% <0 OR A% >99 THEN PRINT P$;: GOTO 1890
1930 QOH = A%
1940 VTAB 12: HTAB 14: CALL -868: INPUT "";A$
1950 IF A$ = "^" THEN 1900
1960 IF A$ = "" AND ED THEN A$ = STR$(FS): VTAB 12: HTAB 14: PRINT A$
1970 A% = VAL(A$): IF A% <0 OR A% >99 THEN PRINT P$;: GOTO 1940
1980 FS = A%
1990 VTAB 15: HTAB 9: CALL -868: INPUT "";A$
2000 IF A$ = "^" THEN 1900
2010 IF ED AND A$ = "" THEN A$ = STR$(IL): VTAB 15: HTAB 9: PRINT A$
2020 A% = VAL(A$): IF A% <1 OR A% >(SA) THEN PRINT P$;: GOTO 1990
2030 IF IL < >A% AND AI%(A%,0) +1 >SQ THEN CALL -868: PRINT " <AISLE FULL.>";P$;: GOSUB 490: HTAB 1: CALL -868: GOTO 1990
2040 NYL = A%
2050 VTAB 18: HTAB 8: CALL -868: INPUT "";A$
2060 IF A$ = "^" THEN 1900
2070 IF ED AND A$ = "" THEN A$ = TP$(TY): VTAB 18: HTAB 8: PRINT A$
2080 IF A$ = "" THEN PRINT P$;: GOTO 2050
2090 L = LEN(A$)
2095 REM SEARCH FOR TYPE
2100 FOR I = 1 TO ST
2110 IF A$ = LEFT$(TP$(I),L) THEN 2140
2120 NEXT I
2130 PRINT P$;: GOTO 2050
2140 A$ = TP$(I): IF TY < >I AND TI%(I,0) +1 >SQ THEN CALL -868: PRINT " <TYPE IS FULL>";P$;: GOSUB 490: HTAB 1: CALL -868: GOTO 2050
2145 VTAB 18: HTAB 8: CALL -868: PRINT A$
2150 NTY = I
2160 VTAB 21: INPUT " OK (Y)? ";A$
2170 IF LEFT$(A$,1) = "Y" OR A$ = "" THEN 2190
2180 PRINT " <IGNORED!>";P$;: GOSUB 490: GOTO 1580
2190 IF NOT ED THEN 2350
2195 REM ON EDIT, DEINDEX AISLE IF NECESSARY AND REINDEX
2200 N$(HIT) = C$: IF IL = NYL THEN 2250
2210 FOR I = 1 TO SQ
2215 REM MOVE LAST ONE IN AISLE TO HOLE LEFT BY REMOVING OLD AISLE
2220 IF AI%(IL,I) = HIT THEN AI%(IL,I) = AI%(IL,AI%(IL,0)):AI%(IL,0) = AI%(IL,0) -1: GOTO 2240
2230 NEXT I
2235 REM INDEX NEW AISLE TO LAST POSITION IN AISLE ARRAY
2240 AI%(NYL,0) = AI%(NYL,0) +1:AI%(NYL,AI%(NYL,0)) = HIT
2245 REM CHECK FOR NEED TO DEINDEX-REINDEX NEW TYPE
2250 IF TY = NTY THEN 2300
2260 FOR I = 1 TO SQ
2270 IF TI%(TY,I) = HIT THEN TI%(TY,I) = TI%(TY,TI%(TY,0)):TI%(TY,0) = TI%(TY,0) -1: GOTO 2290
2280 NEXT I
2290 TI%(NTY,0) = TI%(NTY,0) +1:TI%(NTY,TI%(NTY,0)) = HIT
2300 PRINT D$;"OPEN";FL$;",L40"
2310 PRINT D$;"WRITE";FL$;",R";HIT
2315 REM WRITE NEW DATA TO DISK
2320 PRINT QOH: PRINT FS: PRINT NYL: PRINT NTY: PRINT C$: PRINT HM
2330 PRINT D$;"CLOSE";FL$
2340 GOTO 2440
2345 REM -ON INPUT, INDEX AISLE,TYPE,NAME
2350 N$(LL +1) = C$:LL = LL +1
2360 AI%(NYL,0) = AI%(NYL,0) +1:AI%(NYL,AI%(NYL,0)) = LL
2370 TI%(NTY,0) = TY%(NTY,0) +1:TI%(NTY,TI%(NTY,0)) = LL
2380 PRINT D$;"OPEN";FL$;",L40"
2390 PRINT D$;"WRITE";FL$;",R1"
2395 REM NEW # OF RECORDS
2400 PRINT LL
2410 PRINT D$;"WRITE";FL$;",R";LL
2415 REM WRITE NEW DATA TO DISK
2420 PRINT QOH: PRINT FS: PRINT NYL: PRINT NTY: PRINT C$: PRINT 0
2430 PRINT D$;"CLOSE";FL$
2440 VTAB 23: PRINT " <FILED.>";: GOSUB 490: GOTO 1580
2499 REM
2500 REM ** VIEW **
2510 REM
2520 A$ = "VIEW": GOSUB 52000
2530 VTAB 4: INPUT "WHICH GROCERY? ";A$
2540 IF A$ = "^" OR A$ = "" THEN RETURN
2550 GOSUB 20: REM SEARCH
2560 IF NOT HIT THEN 2680
2565 VTAB 5: CALL -958
2570 PRINT : PRINT "-----------------------------------"
2580 PRINT D$;"OPEN";FL$;",L40"
2590 PRINT D$;"READ";FL$;",R";HIT
2600 INPUT QOH,FS,IL,TY,C$
2610 PRINT D$;"CLOSE";FL$
2620 PRINT "GROCERY: ";C$
2630 PRINT TAB( 5);"QOH: ";QOH
2640 PRINT TAB( 5);"FULL STCK: ";FS
2650 PRINT TAB( 5);"AISLE: ";IL
2660 PRINT TAB( 5);"TYPE: ";TP$(TY)
2670 PRINT "-----------------------------------"
2680 VTAB 23: PRINT " <HIT ANY KEY TO CONTINUE...";
2690 GET A$: PRINT
2700 GOTO 2520
2799 REM
2800 REM ** LIST **
2810 REM
2815 REM L=1 FOR LIST
2820 A$ = "LIST": GOSUB 52000:L = 1: GOTO 2860
2829 REM
2830 REM ** PRINT STATS **
2840 REM
2845 REM L=0 FOR PRNT STATS
2850 A$ = "PRINT STATISTICS": GOSUB 52000:L = 0
2860 VTAB 6: PRINT "BY AISLE OR": PRINT " TYPE OF GROCERY (A / T):"
2870 VTAB 10: PRINT "TO SCREEN OR PRINTER (SCREEN):"
2880 VTAB 7: HTAB 29: CALL -868: INPUT "";A$
2890 IF A$ = "^" THEN RETURN
2895 REM A%=1 FOR AISLE, 0 FOR TYPE
2900 A$ = LEFT$(A$,1): IF A$ = "A" OR A$ = "" THEN A% = 1: VTAB 7: HTAB 29: PRINT "AISLE": GOTO 2930
2910 IF A$ = "T" THEN A% = 0: VTAB 7: HTAB 29: PRINT "TYPE": GOTO 2930
2920 PRINT P$;: GOTO 2880
2930 VTAB 10: HTAB 32: CALL -868: INPUT "";A$
2940 IF A$ = "^" THEN RETURN
2945 REM K=1 FOR PRINTER, 0 FOR SCRN
2950 A$ = LEFT$(A$,1): IF A$ = "P" THEN K = 1: VTAB 10: HTAB 32: PRINT "PRINTER": GOTO 2975
2960 IF A$ = "" OR A$ = "S" THEN K = 0: VTAB 10: HTAB 32: PRINT "SCREEN": GOTO 2975
2970 PRINT P$;: GOTO 2930
2975 GOSUB 4500: REM ASK FROM/TO
2980 VTAB 21: HTAB 10: PRINT "<TYPE '^' TO ABORT>"
2990 IF NOT K THEN GOSUB 490: HOME
3000 IF K THEN PRINT D$;"PR#";SLOT
3010 PRINT : IF L THEN PRINT TAB( 12);"GROCERY FILE LIST": PRINT : IF NOT A% THEN PRINT " ITEM"; TAB( 25);"QOH FSTK AISLE"
3020 IF NOT L THEN PRINT TAB( 12);"STATISTICS LIST": PRINT : IF NOT A% THEN PRINT " ITEM"; TAB( 25);"AISLE TO DATE"
3030 IF A% THEN 3230
3035 REM -BY TYPE
3040 PRINT
3045 PRINT D$;"OPEN";FL$;",L40"
3047 REM LOOP FROM FR TO TA AS ENTERED BY USER
3050 FOR I = FR TO TA
3060 J = 1
3070 FOR Q = 1 TO TI%(I,0)
3080 IF PEEK( -16384) >127 THEN K = PEEK( -16384): POKE -16368,0: IF K = 222 THEN PRINT : PRINT "<ABORTED>": GOTO 3420
3090 IF TI%(I,0) = 0 THEN 3190
3100 IF J THEN PRINT : PRINT TP$(I):J = 0
3110 HIT = TI%(I,Q)
3130 PRINT D$;"READ";FL$;",R";HIT
3140 INPUT QOH,FS,IL,TY,C$,HM
3150 PRINT TAB( 3);C$; TAB( 25);
3160 IF L THEN PRINT QOH; TAB( 30);FS; TAB( 36);IL
3170 IF NOT L THEN PRINT " ";IL; TAB( 35);HM
3190 NEXT Q
3200 NEXT I
3210 GOTO 3420
3220 REM -BY AISLE-
3230 IF L THEN PRINT " ITEM"; TAB( 24);"QOH FS TYPE"
3240 IF NOT L THEN PRINT " ITEM"; TAB( 24);"TYPE TO DATE"
3250 PRINT
3255 PRINT D$;"OPEN";FL$;",L40"
3260 FOR I = FR TO TA
3270 J = 1
3280 FOR Q = 1 TO AI%(I,0)
3290 IF PEEK( -16384) >127 THEN K = PEEK( -16384): POKE -16368,0: IF K = 222 THEN PRINT : PRINT "<ABORTED>": GOTO 3420
3300 IF AI%(I,0) = 0 THEN 3400
3310 IF J THEN PRINT : PRINT "AISLE ";I:J = 0
3320 HIT = AI%(I,Q)
3340 PRINT D$;"READ";FL$;",R";HIT
3350 INPUT QOH,FS,IL,TY,C$,HM
3360 PRINT " ";C$; TAB( 24);
3370 IF L THEN PRINT QOH; TAB( 28);FS; TAB( 31); LEFT$(TP$(TY),9)
3380 IF NOT L THEN PRINT LEFT$(TP$(TY),9); TAB( 35);HM
3400 NEXT Q
3410 NEXT I
3420 PRINT D$;"PR#0"
3430 PRINT D$;"CLOSE";FL$
3450 PRINT " <HIT ANY KEY TO CONTINUE...";
3460 GET A$: PRINT
3470 RETURN
3499 REM
3500 REM ** DELETE **
3510 REM
3520 A$ = "DELETE": GOSUB 52000
3530 VTAB 5: INPUT "WHICH GROCERY? ";A$
3540 IF A$ = "^" OR A$ = "" THEN RETURN
3550 GOSUB 20: REM SEARCH
3560 IF NOT HIT THEN GOSUB 490: VTAB 4: CALL -958: GOTO 3530
3570 VTAB 6: CALL -958
3580 VTAB 10: PRINT "DELETE ";N$(HIT): INPUT "...ARE YOU SURE? ";A$
3590 IF LEFT$(A$,1) < >"Y" THEN HIT = 0: PRINT " <NOT DELETED!>": GOTO 3560
3600 PRINT D$;"OPEN";FL$;",L40"
3610 PRINT D$;"READ";FL$;",R";HIT
3620 INPUT I,I,IL,TY
3630 PRINT D$;"READ";FL$;",R";LL
3635 INPUT QOH,FS,K,L,C$,HM
3640 PRINT D$;"CLOSE";FL$
3645 REM DEINDEX FROM TYPE AND AISLE ARRAYS
3650 FOR I = 1 TO TI%(TY,0)
3660 IF TI%(TY,I) = HIT THEN 3680
3670 NEXT I
3680 TI%(TY,I) = TI%(TY,TI%(TY,0)):TI%(TY,0) = TI%(TY,0) -1
3690 FOR I = 1 TO AI%(IL,0)
3700 IF AI%(IL,I) = HIT THEN 3720
3710 NEXT I
3720 AI%(IL,I) = AI%(IL,AI%(IL,0))
3730 AI%(IL,0) = AI%(IL,0) -1
3740 N$(HIT) = N$(LL):LL = LL -1
3745 REM WRITE LAST RECORD INTO HOLE LEFT BY DELETED RECORD
3746 REM WRITE OUT NEW LL (COUNT OF REC'S)
3750 PRINT D$;"OPEN";FL$;",L40"
3760 PRINT D$;"WRITE";FL$;",R";HIT
3770 PRINT QOH: PRINT FS: PRINT K: PRINT L: PRINT C$: PRINT HM
3780 PRINT D$;"WRITE";FL$;",R1"
3790 PRINT LL
3800 PRINT D$;"CLOSE";FL$
3810 PRINT " <DELETED.>":HIT = 0: GOTO 3560
3899 REM
3900 REM ** EDIT STATS **
3910 REM
3920 A$ = "EDIT STATISTICS": GOSUB 52000
3930 VTAB 6: INPUT "WHICH GROCERY? ";A$
3940 IF A$ = "" OR A$ = "^" THEN RETURN
3945 REM SEARCH
3950 GOSUB 20: IF NOT HIT THEN GOSUB 490: VTAB 5: CALL -958: GOTO 3930
3960 VTAB 7: CALL -958
3970 PRINT D$;"OPEN";FL$;",L40"
3980 PRINT D$;"READ";FL$;",R";HIT
3990 INPUT QOH,FS,IL,TY,C$,HM
4000 PRINT D$;"CLOSE";FL$
4010 VTAB 10: PRINT C$; TAB( 25);"AISLE ";IL
4020 PRINT " (";TP$(TY);") FL STCK=";FS
4030 PRINT : PRINT " =>> TO DATE: ";HM
4040 VTAB 15: HTAB 1: CALL -868: INPUT "UPDATE STATS BY (+ OR -N): ";A$
4050 IF A$ = "^" THEN RETURN
4055 IF LEN(A$) >4 THEN PRINT P$;: GOTO 4040
4060 A% = VAL(A$):A% = A% +HM
4070 IF A% <0 OR A% >9999 THEN PRINT P$;: GOTO 4040
4080 VTAB 17: HTAB 5: CALL -868: PRINT "NEW TO DATE: ";A%
4090 HTAB 5: INPUT " OK (Y)? ";A$
4100 IF LEFT$(A$,1) < >"Y" AND A$ < >"" THEN PRINT " <NOT FILED.>": GOSUB 490: VTAB 14: CALL -958: GOTO 4040
4110 PRINT D$;"OPEN";FL$;",L40"
4120 PRINT D$;"WRITE";FL$;",R";HIT
4130 PRINT QOH: PRINT FS: PRINT IL: PRINT TY: PRINT C$
4140 PRINT A%: REM NEW TO DATE
4150 PRINT D$;"CLOSE";FL$
4160 PRINT " <FILED.>": GOSUB 490: VTAB 5
4170 CALL -958: GOTO 3930
4199 REM
4200 REM ** VIEW STATS **
4210 REM
4220 A$ = "VIEW A GROCERY'S STATS": GOSUB 52000
4230 VTAB 6: INPUT "WHICH GROCERY? (^ TO END) ";A$
4240 IF A$ = "" OR A$ = "^" THEN RETURN
4245 REM SEARCH
4250 GOSUB 20: IF NOT HIT THEN GOSUB 490: VTAB 5: CALL -958: GOTO 4230
4260 VTAB 7: CALL -958
4270 PRINT D$;"OPEN";FL$;",L40"
4280 PRINT D$;"READ";FL$;",R";HIT
4290 INPUT QOH,FS,IL,TY,C$,HM
4300 PRINT D$;"CLOSE";FL$
4310 PRINT : PRINT "-----------------------------------"
4320 PRINT "GROCERY: ";C$
4330 PRINT TAB( 5);"FULL STOCK: ";FS
4340 PRINT TAB( 5);"AISLE: ";IL
4350 PRINT TAB( 5);"TYPE: ";TP$(TY)
4360 PRINT : PRINT TAB( 5);"=>> TO DATE: ";HM
4370 PRINT "-----------------------------------"
4380 VTAB 20: PRINT " <HIT ANY KEY TO CONTINUE...";
4390 GET A$: PRINT
4400 VTAB 5: CALL -958
4410 GOTO 4230
4499 REM
4500 REM -ASK FROM/TO-
4502 REM FOR 'LIST' AND 'PRNT STATS'
4505 REM
4510 IF A% THEN 4610
4515 REM -TYPE-
4520 VTAB 14: HTAB 1: CALL -868: INPUT "FOR GROCERY TYPE (ALL): ";A$
4540 IF A$ = "^" THEN POP : RETURN
4550 IF A$ = "" OR LEFT$(A$,3) = "ALL" THEN FR = 1:TA = ST: VTAB 14: HTAB 25: PRINT "ALL": RETURN
4560 J = LEN(A$): FOR I = 1 TO ST: IF A$ = LEFT$(TP$(I),J) THEN 4590
4570 NEXT I
4580 PRINT P$;: GOTO 4520
4590 VTAB 14: HTAB 25: PRINT TP$(I)
4600 FR = I:TA = I: RETURN
4610 REM -AISLE-
4620 VTAB 14: HTAB 1: PRINT "FROM AISLE (FIRST):"
4630 VTAB 17: HTAB 1: PRINT "TO AISLE (LAST):"
4640 VTAB 14: HTAB 21: CALL -868: INPUT "";A$
4650 IF A$ = "^" THEN POP : RETURN
4660 IF A$ = "" THEN A$ = "1": VTAB 14: HTAB 21: PRINT "FIRST"
4670 FR = VAL(A$): IF FR <1 OR FR >(SA) THEN PRINT P$;: GOTO 4640
4680 VTAB 17: HTAB 18: CALL -868: INPUT "";A$
4690 IF A$ = "^" THEN POP : RETURN
4700 IF A$ = "" THEN A$ = STR$(SA): VTAB 17: HTAB 18: PRINT "LAST"
4710 TA = VAL(A$): IF TA <1 OR TA >(SA) THEN PRINT P$;: GOTO 4680
4720 IF FR >(TA) THEN VTAB 17: HTAB 30: PRINT "<ORDER?>";P$;: GOSUB 490: HTAB 18: CALL -868: GOTO 4640
4730 RETURN
17999 REM
18000 REM -DATA FOR TYPES-
18010 REM
18020 DATA BAKING,BEVERAGES,BREAKFAST,CANNED,COOKIES/CAKES/BREAD,DAIRY
18030 DATA DETERGENTS,DESSERTS,FROZEN,MEATS,MISCELLANEOUS,PAPER GOODS,PRODUCE,SPICES/DRESSINGS
19999 REM
20000 REM ** INIT FILES **
20010 REM
20020 A$ = "INITIALIZE FILES": GOSUB 52000
20030 VTAB 10: PRINT " <INITIALIZING ";FL$;"....."
20040 PRINT : PRINT :QOH = 0:FS = 0:HM = 0:LL = 2
20045 GOSUB 20250: REM INIT ARRAYS
20047 PRINT D$;"OPEN";FL$;",L40"
20050 FOR I = 1 TO ST
20060 READ TY,K
20070 FOR J = 1 TO K
20080 READ C$,IL
20100 PRINT D$;"WRITE";FL$;",R";LL
20110 PRINT QOH: PRINT FS: PRINT IL: PRINT TY: PRINT C$: PRINT HM
20120 REM INDEX ARRAYS (TYPE,AISLE,NAME)
20140 TI%(TY,0) = TI%(TY,0) +1:TI%(TY,TI%(TY,0)) = LL
20150 AI%(IL,0) = AI%(IL,0) +1:AI%(IL,AI%(IL,0)) = LL
20170 N$(LL) = C$
20175 LL = LL +1
20180 NEXT J
20200 NEXT I
20205 PRINT D$;"CLOSE";FL$
20207 REM DECREMENT LL: COUNT OF ITEMS
20210 LL = LL -1
20215 GOSUB 20350: REM WRITE LL TO DISK
20220 PRINT : PRINT P$;"ALL DONE."
20230 GOSUB 490
20240 RETURN
20250 REM -INIT ARRAYS
20260 FOR I = 0 TO ST
20270 FOR J = 1 TO SQ
20280 TI%(I,J) = 0
20290 NEXT J,I
20300 FOR I = 1 TO SA
20310 FOR J = 1 TO SQ
20320 AI%(I,J) = 0
20330 NEXT J,I
20340 RETURN
20349 REM -1ST RECORD: LL (COUNT)
20350 PRINT D$;"OPEN";FL$;",L40"
20360 PRINT D$;"WRITE";FL$;",R1"
20370 PRINT LL
20380 PRINT D$;"CLOSE";FL$
20390 RETURN
20400 REM -DATA
20410 REM TYPE,COUNT
20420 DATA 1,13
20425 REM NAME,AISLE
20430 DATA RAISINS,4,NUTS,4,SUGAR,4,FLOUR,4,BROWN SUGAR,4,BAKING SODA,4,BAKING POWDER,4,CINNAMON,4,NUTMEG,4
20440 DATA VANILLA FLAVORING,4,SHORTENING,4,BAKING CHOCOLATE,4,SHREDDED COCONUT,4
20450 DATA 2,3
20460 DATA COFFEE,4,TEA,4,SODA,6
20470 DATA 3,2
20480 DATA CEREAL,5,PANCAKE MIX,4
20490 DATA 4,16
20500 DATA CORN-SM CAN,2,CORN-LG CAN,2,PEAS-CAN,2,GR BEANS-CAN,2,MUSHROOMS-CAN,2,BEETS-CAN,2,TOMATO SOUP,5
20510 DATA VEGETABLE SOUP,5,CHICKEN SOUP,5,TOMATO PASTE,5,FRUIT COCKTAIL,2,PEACHES-CAN,2,PEARS-CAN,2
20520 DATA GRAPEFRUIT-CAN,2,CRANBERRIES,2,PINEAPPLE-CAN,2
20530 DATA 5,4
20540 DATA CRACKERS,5,COOKIES,5,CAKE,5,BREAD,5
20550 DATA 6,5
20560 DATA CHEESE,12,MILK,12,BUTTER,12,MARGARINE,12,EGGS,12
20570 DATA 7,4
20580 DATA SOAP,8,SHAMPOO,8,DETERGENT,8,FABRIC SOFTENER,8
20590 DATA 8,3
20600 DATA GELATIN,7,PUDDING,7,ICE CREAM,11
20610 DATA 9,5
20620 DATA CARROTS-FROZ,10,GR BEANS-FROZ,10,CORN-FROZ,10,BROCCOLLI-FROZ,10,FRENCH FRIES,10
20630 DATA 10,5
20640 DATA COLD CUTS,10,CHICKEN,1,PORK,1,BEEF,1,FISH,1
20650 DATA 11,5
20660 DATA JAM/JELLY,3,PEANUT BUTTER,3,MARSHMALLOW,3,SOAP PADS,8,SPONGES,8
20670 DATA 12,5
20680 DATA TISSUES,8,TOILET PAPER,8,NAPKINS,8,PAPER TOWELS,8,PAPER CUPS,8
20690 DATA 13,17
20700 DATA ORANGES,1,APPLES,1,BANANAS,1,PEACHES,1,PEARS,1,GRAPES,1,CHERRIES,1,CANTELOUPE,1,WATERMELON,1,SQUASH,1
20710 DATA LETTUCE,1,TOMATOES,1,CELERY,1,CUCUMBERS,1,GREEN PEPPERS,1,CARROTS,1,POTATOES,1
20720 DATA 14,9
20730 DATA MUSTARD,9,PICKLES,9,PICKLE RELISH,9,KETCHUP,9,SALT,9,PEPPER,9,SALAD DRESSING,9,OIL,9,TOMATO SAUCE,9
29999 REM
30000 REM ** QUIT **
30010 REM
30020 A$ = "QUIT": GOSUB 52000
30030 VTAB 6
30040 INPUT "ARE YOU SURE? ";A$
30050 IF LEFT$(A$,1) < >"Y" THEN RETURN
30060 VTAB 10: PRINT "APPLE MAPS"; TAB( 24);"BY GLENN TEMAN"
30070 PRINT "(C) 1981"; TAB( 24);"NIBBLE MAGAZINE"
30080 VTAB 20: PRINT "GOODBYE!": PRINT
30090 END
49999 REM
50000 REM ** MAIN MENU **
50010 REM
50020 HOME : PRINT TAB( 14);: INVERSE
50030 PRINT " APPLE MAPS ": NORMAL : VTAB 5
50040 PRINT "1 - VIEW GROCERY LIST": PRINT
50050 PRINT "2 - PRINT GROCERY LIST": PRINT
50060 PRINT "3 - UPDATE INVENTORY": PRINT
50070 PRINT "4 - FILE MAINTENANCE": PRINT
50080 PRINT "5 - STATISTICS": PRINT
50090 PRINT "6 - QUIT"
50095 PRINT : PRINT "THE '^' WILL ALLOW YOU TO RETURN TO": PRINT "THE MENU FROM A SELECTED OPTION."
50100 VTAB 21
50110 INPUT "OPTION: ";A$:J = VAL(A$)
50120 IF J <1 OR J >6 THEN PRINT P$: GOTO 50020
50130 ON J GOSUB 530,500,1200,51000,51350,30000
50140 GOTO 50020
50999 REM
51000 REM ** FILE MNT MENU **
51010 REM
51020 HOME : PRINT TAB( 14);: INVERSE
51030 PRINT " APPLE MAPS ": NORMAL : VTAB 3
51040 PRINT "** FILE MAINTENANCE **": VTAB 6
51050 PRINT "0 - RETURN TO MAIN MENU": PRINT
51060 PRINT "1 - INPUT GROCERY": PRINT
51070 PRINT "2 - EDIT GROCERY": PRINT
51080 PRINT "3 - VIEW GROCERY": PRINT
51090 PRINT "4 - LIST INVENTORY": PRINT
51100 PRINT "5 - DELETE GROCERY": PRINT
51110 PRINT "6 - (INITIALIZE FILES)"
51120 VTAB 22
51130 INPUT "F.MNT.OPTION: ";A$:J = VAL(A$)
51140 IF J <0 OR J >6 THEN PRINT P$: GOTO 51020
51150 IF J = 0 AND LEFT$(A$,1) < >"0" THEN PRINT P$: GOTO 51020
51160 IF J < >6 THEN 51270
51170 REM -INIT FILES CHOSEN-
51180 HOME : VTAB 7
51190 PRINT "INITIALIZE FILES...YOU SHOULD ONLY DO"
51200 PRINT "THIS WHEN YOU'RE FIRST USING THIS SOFT-"
51210 PRINT "WARE! THIS OPTION WILL DESTROY THE FILE"
51220 PRINT "NAMED ";FL$;" AND CREATE A NEW"
51230 PRINT "ONE ....."
51240 VTAB 20: INPUT "INITIALIZE? ";A$
51250 IF LEFT$(A$,1) < >"Y" THEN 51020
51260 REM -OK TO PROCEED-
51270 IF J = 0 THEN RETURN : REM TO MAIN MENU
51280 ON J GOSUB 1500,1550,2500,2800,3500,20000
51290 GOTO 51020
51349 REM
51350 REM ** STATS MENU **
51360 REM
51370 HOME : PRINT TAB( 14);: INVERSE
51380 PRINT " APPLE MAPS ": NORMAL : VTAB 4
51390 PRINT "** STATISTICS **": VTAB 8
51400 PRINT "0 - RETURN TO MAIN MENU": PRINT
51410 PRINT "1 - EDIT STATISTICS": PRINT
51420 PRINT "2 - PRINT STATISTICS": PRINT
51430 PRINT "3 - VIEW A GROCERY'S STATISTICS"
51440 VTAB 20
51450 INPUT "STATS.OPTION: ";A$:J = VAL(A$)
51460 IF J <0 OR J >3 THEN PRINT P$: GOTO 51370
51470 IF J = 0 AND LEFT$(A$,1) < >"0" THEN PRINT P$: GOTO 51370
51480 IF J = 0 THEN RETURN : REM TO MAIN MENU
51490 ON J GOSUB 3900,2830,4200
51500 GOTO 51370
51999 REM
52000 REM ** TITLES **
52010 REM
52015 HOME
52020 A$ = " " +A$ +" "
52030 PRINT TAB( (40 - LEN(A$))/2);
52040 INVERSE : PRINT A$: NORMAL
52050 PRINT
52060 RETURN
52099 REM
52100 REM ** TYPES OF GROCS **
52110 REM
52120 FOR I = 1 TO ST
52130 READ TP$(I)
52140 NEXT I
52145 REM DATA @18000
52150 RETURN
60000 REM ** TITLE PG & INIT **
60005 HOME
60010 VTAB 10: HTAB 10: INVERSE : FOR F = 1 TO 25: PRINT "*";: NEXT : NORMAL : PRINT
60030 HTAB 10: PRINT "THE APPLE M.A.P.S. SYSTEM": HTAB 10: PRINT " BY GLENN TEMAN ": HTAB 10: PRINT " COPYRIGHT (C) 1981 ": HTAB 10: PRINT " BY MICRO-SPARC INC "
60040 HTAB 10: INVERSE : FOR F = 1 TO 25: PRINT "*";: NEXT : NORMAL : PRINT
60200 REM -INIT-
60205 REM SLOT=PRINT SLOT,SZ=SZ OF NAME ARRAY, SA=SZ OF AISLE ARRAY
60206 REM ST=SZ OF TYPE ARRAY,SQ=# IN EACH TYPE/AISLE
60210 D$ = CHR$(4):SLOT = 1:SZ = 300:SA = 14:ST = 14:SQ = 30
60220 DIM N$(SZ),AI%(SA,SQ),TI%(ST,SQ)
60228 REM ARRAY FOR HITS AND TYPE NAMES
60230 DIM C%(11),TP$(ST): GOSUB 52100
60240 FL$ = "GROCERIES.FILE":P$ = CHR$(7):I = 0
60250 REM -READ FILE-
60260 ONERR GOTO 62000
60270 PRINT D$;"OPEN";FL$;",L40"
60280 PRINT D$;"READ";FL$;",R1"
60290 INPUT LL
60300 FOR I = 2 TO LL
60310 PRINT D$;"READ";FL$;",R";I
60320 INPUT J,K,IL,TY,A$
60325 REM INDEX ARRAYS
60330 N$(I) = A$:AI%(IL,0) = AI%(IL,0) +1
60340 AI%(IL,AI%(IL,0)) = I:TI%(TY,0) = TI%(TY,0) +1
60350 TI%(TY,TI%(TY,0)) = I
60360 NEXT I
60370 PRINT D$;"CLOSE";FL$
60380 VTAB 23: HTAB 6: PRINT "<HIT ANY KEY TO CONTINUE...";P$;
60385 REM OFF THE ONERR
60390 POKE 216,0: GET A$: PRINT
60395 TEXT
60400 GOTO 50000: REM MAIN MENU
61999 REM
62000 REM ** HANDLE ONERR **
62010 REM
62020 REM ONLY HANDLE 'OUT OF DATA' DUE TO FILE NOT THERE
62030 J = PEEK(222):K = PEEK(218) + PEEK(219) *256
62040 IF J < >5 THEN 62200
62050 REM -OUT OF DATA-
62055 REM IF I>3 THEN OUT OF DATA NOT CAUSED BY MISSING FILE!
62060 IF I >3 THEN 62200
62070 PRINT D$;"DELETE";FL$
62080 POKE 216,0
62090 VTAB 23: HTAB 6: PRINT "<HIT ANY KEY TO CONTINUE...";
62100 GET A$: PRINT
62105 TEXT
62110 HOME : VTAB 5
62120 PRINT FL$;" DOES NOT EXIST ON THIS": PRINT "DISK. PLEASE INSERT A DISK THAT IS NOT"
62130 PRINT "WRITE-PROTECTED WITH AT LEAST 60 EMPTY": PRINT "SECTORS.": PRINT
62140 PRINT "USE THE 'INITIALIZE' OPTION UNDER FILE": PRINT "MAINTENANCE TO SET UP THIS FILE."
62150 VTAB 20: HTAB 6: PRINT "<HIT ANY KEY TO CONTINUE...";: GET A$: PRINT
62160 GOTO 50000: REM MENU
62200 REM -OTHER ERROR-
62205 TEXT
62210 HOME : VTAB 5: PRINT P$;P$;P$
62220 PRINT "ERROR: ";J
62230 PRINT " ON LINE ";K;" ..."
62240 PRINT : PRINT "<ABORTING.>": PRINT : PRINT
62250 END
62255 REM
62260 REM (C) GLENN TEMAN
62265 REM NIBBLE MAGAZINE 1981